{4:}PROGRAM GFTOAMF(GFFILE,AMFFILE,OUTPUT);LABEL{5:}9999;{:5}CONST{6:}
MAXCHARNO=255;TOPPIXEL=1000;BOTPIXEL=-300;LEFTPIXEL=-300;RIGHTPIXEL=900;
{:6}TYPE{10:}ASCIICODE=32..126;{:10}{11:}TEXTFILE=PACKED FILE OF CHAR;
{:11}{22:}EIGHTBITS=0..255;BYTEFILE=PACKED FILE OF EIGHTBITS;{:22}{31:}
XCOORD=LEFTPIXEL..RIGHTPIXEL;YCOORD=BOTPIXEL..TOPPIXEL;{:31}{33:}
PIXEL=0..1;{:33}VAR{12:}XORD:ARRAY[CHAR]OF ASCIICODE;
XCHR:ARRAY[0..255]OF CHAR;{:12}{23:}GFFILE:BYTEFILE;AMFFILE:BYTEFILE;
{:23}{26:}CURLOC:INTEGER;AMFBYTENO:INTEGER;{:26}{32:}X,Z:XCOORD;
Y:YCOORD;PAINTSWITCH:PIXEL;{:32}{34:}
IMAGEARRAY:PACKED ARRAY[YCOORD,XCOORD]OF PIXEL;{:34}{37:}
CHARACTERCOD:INTEGER;TOTALCHARS:INTEGER;{:37}{50:}COLS,ROWS:INTEGER;
{:50}{52:}DESIGNSIZE:INTEGER;MINX,MAXX,MINY,MAXY:INTEGER;
HPPP,VPPP:INTEGER;CHECKSUM:INTEGER;POSTLOC:INTEGER;MAGNIFICATIO:REAL;
TFMWIDTH:ARRAY[0..MAXCHARNO]OF INTEGER;
DEVICEWIDTH:ARRAY[0..MAXCHARNO]OF INTEGER;{:52}{57:}
SUBGLYPHPTR:ARRAY[0..MAXCHARNO]OF INTEGER;BC,EC:INTEGER;
AMFDIRPTR:INTEGER;AMFMAG:INTEGER;{:57}{62:}NIBBLE:0..511;
BYTEQUEUE:ARRAY[1..255]OF EIGHTBITS;BYTECOUNT:0..255;{:62}{65:}
STARTSTOPVAL,OLDSTARTSTOP:ARRAY[1..126]OF BOTPIXEL..TOPPIXEL;
NUMSTARTSTOP,OLDNUMSTARTS:0..126;NUMRUNS:0..63;PARTBOT,PARTTOP:YCOORD;
YOFFSET:INTEGER;{:65}{67:}REPEATCOUNT:INTEGER;
DIRECTION:ARRAY[1..129]OF PIXEL;DELTA:ARRAY[1..129]OF INTEGER;{:67}{69:}
BLOEXP:INTEGER;VSPOTS:INTEGER;AVAL,CVAL:INTEGER;{:69}{83:}
LASTSUBGLYPH:INTEGER;PARTYOFFSET:INTEGER;{:83}{91:}A:INTEGER;
M,N,O,P,Q:INTEGER;BADCHAR:BOOLEAN;{:91}PROCEDURE INITIALIZE;
VAR I:INTEGER;BEGIN WRITELN('This is GFtoAMF, Version 1.0');{13:}
FOR I:=0 TO 31 DO XCHR[I]:='?';XCHR[32]:=' ';XCHR[33]:='!';
XCHR[34]:='"';XCHR[35]:='#';XCHR[36]:='$';XCHR[37]:='%';XCHR[38]:='&';
XCHR[39]:='''';XCHR[40]:='(';XCHR[41]:=')';XCHR[42]:='*';XCHR[43]:='+';
XCHR[44]:=',';XCHR[45]:='-';XCHR[46]:='.';XCHR[47]:='/';XCHR[48]:='0';
XCHR[49]:='1';XCHR[50]:='2';XCHR[51]:='3';XCHR[52]:='4';XCHR[53]:='5';
XCHR[54]:='6';XCHR[55]:='7';XCHR[56]:='8';XCHR[57]:='9';XCHR[58]:=':';
XCHR[59]:=';';XCHR[60]:='<';XCHR[61]:='=';XCHR[62]:='>';XCHR[63]:='?';
XCHR[64]:='@';XCHR[65]:='A';XCHR[66]:='B';XCHR[67]:='C';XCHR[68]:='D';
XCHR[69]:='E';XCHR[70]:='F';XCHR[71]:='G';XCHR[72]:='H';XCHR[73]:='I';
XCHR[74]:='J';XCHR[75]:='K';XCHR[76]:='L';XCHR[77]:='M';XCHR[78]:='N';
XCHR[79]:='O';XCHR[80]:='P';XCHR[81]:='Q';XCHR[82]:='R';XCHR[83]:='S';
XCHR[84]:='T';XCHR[85]:='U';XCHR[86]:='V';XCHR[87]:='W';XCHR[88]:='X';
XCHR[89]:='Y';XCHR[90]:='Z';XCHR[91]:='[';XCHR[92]:='\';XCHR[93]:=']';
XCHR[94]:='↑';XCHR[95]:='_';XCHR[96]:='`';XCHR[97]:='a';XCHR[98]:='b';
XCHR[99]:='c';XCHR[100]:='d';XCHR[101]:='e';XCHR[102]:='f';
XCHR[103]:='g';XCHR[104]:='h';XCHR[105]:='i';XCHR[106]:='j';
XCHR[107]:='k';XCHR[108]:='l';XCHR[109]:='m';XCHR[110]:='n';
XCHR[111]:='o';XCHR[112]:='p';XCHR[113]:='q';XCHR[114]:='r';
XCHR[115]:='s';XCHR[116]:='t';XCHR[117]:='u';XCHR[118]:='v';
XCHR[119]:='w';XCHR[120]:='x';XCHR[121]:='y';XCHR[122]:='z';
XCHR[123]:='{';XCHR[124]:='|';XCHR[125]:='}';XCHR[126]:='~';
FOR I:=127 TO 255 DO XCHR[I]:='?';{:13}{14:}
FOR I:=0 TO 127 DO XORD[CHR(I)]:=32;
FOR I:=32 TO 126 DO XORD[XCHR[I]]:=I;{:14}{38:}TOTALCHARS:=0;{:38}{58:}
BC:=MAXCHARNO+1;EC:=-1;FOR I:=0 TO MAXCHARNO DO BEGIN SUBGLYPHPTR[I]:=0;
TFMWIDTH[I]:=0;DEVICEWIDTH[I]:=0;END;{:58}END;{:4}{8:}PROCEDURE JUMPOUT;
BEGIN GOTO 9999;END;{:8}{9:}PROCEDURE PRINTSCALED(S:INTEGER);
VAR DELTA:INTEGER;BEGIN IF S<0 THEN BEGIN WRITE('-');S:=-S;END;
WRITE(S DIV 65536:1);S:=10*(S MOD 65536)+5;IF S<>5 THEN BEGIN DELTA:=10;
WRITE('.');REPEAT IF DELTA>65536 THEN S:=S+32768-(DELTA DIV 2);
WRITE(CHR(ORD('0')+(S DIV 65536)));S:=10*(S MOD 65536);DELTA:=DELTA*10;
UNTIL S<=DELTA;END;END;{:9}{24:}PROCEDURE OPENGFFILE;
BEGIN RESET(GFFILE);CURLOC:=0;END;{:24}{25:}PROCEDURE OPENAMFFILE;
BEGIN REWRITE(AMFFILE);END;{:25}{27:}FUNCTION GETBYTE:INTEGER;
VAR B:EIGHTBITS;
BEGIN IF EOF(GFFILE)THEN GETBYTE:=0 ELSE BEGIN READ(GFFILE,B);
CURLOC:=CURLOC+1;GETBYTE:=B;END;END;FUNCTION SIGNEDBYTE:INTEGER;
VAR B:EIGHTBITS;BEGIN READ(GFFILE,B);CURLOC:=CURLOC+1;
IF B<128 THEN SIGNEDBYTE:=B ELSE SIGNEDBYTE:=B-256;END;
FUNCTION GETTWOBYTES:INTEGER;VAR A,B:EIGHTBITS;BEGIN READ(GFFILE,A);
READ(GFFILE,B);CURLOC:=CURLOC+2;GETTWOBYTES:=A*256+B;END;
FUNCTION SIGNEDPAIR:INTEGER;VAR A,B:EIGHTBITS;BEGIN READ(GFFILE,A);
READ(GFFILE,B);CURLOC:=CURLOC+2;
IF A<128 THEN SIGNEDPAIR:=A*256+B ELSE SIGNEDPAIR:=(A-256)*256+B;END;
FUNCTION GETTHREEBYTE:INTEGER;VAR A,B,C:EIGHTBITS;BEGIN READ(GFFILE,A);
READ(GFFILE,B);READ(GFFILE,C);CURLOC:=CURLOC+3;
GETTHREEBYTE:=(A*256+B)*256+C;END;FUNCTION SIGNEDTRIO:INTEGER;
VAR A,B,C:EIGHTBITS;BEGIN READ(GFFILE,A);READ(GFFILE,B);READ(GFFILE,C);
CURLOC:=CURLOC+3;
IF A<128 THEN SIGNEDTRIO:=(A*256+B)*256+C ELSE SIGNEDTRIO:=((A-256)*256+
B)*256+C;END;FUNCTION SIGNEDQUAD:INTEGER;VAR A,B,C,D:EIGHTBITS;
BEGIN READ(GFFILE,A);READ(GFFILE,B);READ(GFFILE,C);READ(GFFILE,D);
CURLOC:=CURLOC+4;
IF A<128 THEN SIGNEDQUAD:=((A*256+B)*256+C)*256+D ELSE SIGNEDQUAD:=(((A
-256)*256+B)*256+C)*256+D;END;{:27}{28:}
PROCEDURE AMFHALFWORD(W:INTEGER);BEGIN IF W<0 THEN W:=W+65536;
BEGIN WRITE(AMFFILE,W DIV 256);AMFBYTENO:=AMFBYTENO+1;END;
BEGIN WRITE(AMFFILE,W MOD 256);AMFBYTENO:=AMFBYTENO+1;END;END;
PROCEDURE AMFWORD(W:INTEGER);
BEGIN IF W>0 THEN BEGIN WRITE(AMFFILE,W DIV 16777216);
AMFBYTENO:=AMFBYTENO+1;END ELSE BEGIN W:=W+1073741824;W:=W+1073741824;
BEGIN WRITE(AMFFILE,(W DIV 16777216)+128);AMFBYTENO:=AMFBYTENO+1;END;
END;BEGIN WRITE(AMFFILE,(W DIV 65536)MOD 256);AMFBYTENO:=AMFBYTENO+1;
END;BEGIN WRITE(AMFFILE,(W DIV 256)MOD 256);AMFBYTENO:=AMFBYTENO+1;END;
BEGIN WRITE(AMFFILE,W MOD 256);AMFBYTENO:=AMFBYTENO+1;END;END;{:28}{29:}
FUNCTION GFLENGTH:INTEGER;BEGIN SETPOS(GFFILE,-1);
GFLENGTH:=CURPOS(GFFILE);END;PROCEDURE MOVETOBYTE(N:INTEGER);
BEGIN SETPOS(GFFILE,N);CURLOC:=N;END;{:29}{39:}
FUNCTION FIRSTPAR(O:EIGHTBITS):INTEGER;
BEGIN CASE O OF 0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,
22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,
46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63:FIRSTPAR:=O-0;
64,69,246,241:FIRSTPAR:=GETBYTE;65,70,242:FIRSTPAR:=GETTWOBYTES;
66,71,243:FIRSTPAR:=GETTHREEBYTE;72,244,245:FIRSTPAR:=SIGNEDQUAD;
240,67,68,247,248,249,250,251,252,253,254,255:FIRSTPAR:=0;
73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95,96,
97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115
,116,117,118,119,120,121,122,123,124,125,126,127,128,129,130,131,132,133
,134,135,136,137,138,139,140,141,142,143,144,145,146,147,148,149,150,151
,152,153,154,155,156,157,158,159,160,161,162,163,164,165,166,167,168,169
,170,171,172,173,174,175,176,177,178,179,180,181,182,183,184,185,186,187
,188,189,190,191,192,193,194,195,196,197,198,199,200,201,202,203,204,205
,206,207,208,209,210,211,212,213,214,215,216,217,218,219,220,221,222,223
,224,225,226,227,228,229,230,231,232,233,234,235,236,237,238,239:
FIRSTPAR:=O-156;END;END;{:39}{40:}{63:}PROCEDURE DEQUEUE;VAR I:1..255;
BEGIN BEGIN WRITE(AMFFILE,NIBBLE-256);AMFBYTENO:=AMFBYTENO+1;END;
IF BYTECOUNT>0 THEN FOR I:=1 TO BYTECOUNT DO BEGIN WRITE(AMFFILE,
BYTEQUEUE[I]);AMFBYTENO:=AMFBYTENO+1;END;NIBBLE:=1;BYTECOUNT:=0;END;
{:63}{66:}PROCEDURE GETSTARTSTOP;VAR COLOR:PIXEL;BEGIN NUMSTARTSTOP:=0;
COLOR:=1;Y:=PARTBOT;
WHILE Y<=PARTTOP DO BEGIN IF IMAGEARRAY[Y,X]=COLOR THEN BEGIN
NUMSTARTSTOP:=NUMSTARTSTOP+1;STARTSTOPVAL[NUMSTARTSTOP]:=Y+YOFFSET;
IF COLOR=1 THEN COLOR:=0 ELSE COLOR:=1;END;Y:=Y+1;END;
IF COLOR=0 THEN BEGIN NUMSTARTSTOP:=NUMSTARTSTOP+1;
STARTSTOPVAL[NUMSTARTSTOP]:=Y+YOFFSET;END;NUMRUNS:=NUMSTARTSTOP DIV 2;
END;PROCEDURE PRINTSTARTST;VAR I:INTEGER;BEGIN WRITE('start/stop=');
FOR I:=1 TO NUMSTARTSTOP DO WRITE(' ',STARTSTOPVAL[I]:1);WRITELN;END;
{:66}{68:}PROCEDURE DONEREPEATIN;VAR NIBS:INTEGER;
BEGIN{WRITELN('repeat ',REPEATCOUNT:1);}NIBS:=REPEATCOUNT*OLDNUMSTARTS;
IF NIBS>=7 THEN BEGIN WHILE REPEATCOUNT>0 DO BEGIN BEGIN IF NIBBLE>=256
THEN DEQUEUE;NIBBLE:=NIBBLE*4+3;END;BEGIN IF NIBBLE>=256 THEN DEQUEUE;
NIBBLE:=NIBBLE*4+3;END;BEGIN IF NIBBLE>=256 THEN DEQUEUE;
NIBBLE:=NIBBLE*4+2;END;
IF REPEATCOUNT<255 THEN NIBS:=REPEATCOUNT ELSE NIBS:=255;
BEGIN BYTECOUNT:=BYTECOUNT+1;BYTEQUEUE[BYTECOUNT]:=(255-(NIBS));END;
REPEATCOUNT:=REPEATCOUNT-NIBS;END;
END ELSE IF NIBS>0 THEN WHILE NIBS>0 DO BEGIN BEGIN IF NIBBLE>=256 THEN
DEQUEUE;NIBBLE:=NIBBLE*4+0;END;NIBS:=NIBS-1;
END ELSE BEGIN WHILE REPEATCOUNT>0 DO BEGIN BEGIN IF NIBBLE>=256 THEN
DEQUEUE;NIBBLE:=NIBBLE*4+3;END;BEGIN IF NIBBLE>=256 THEN DEQUEUE;
NIBBLE:=NIBBLE*4+3;END;BEGIN IF NIBBLE>=256 THEN DEQUEUE;
NIBBLE:=NIBBLE*4+1;END;BEGIN BYTECOUNT:=BYTECOUNT+1;
BYTEQUEUE[BYTECOUNT]:=0;END;
IF REPEATCOUNT<127 THEN NIBS:=REPEATCOUNT ELSE NIBS:=127;
BEGIN BYTECOUNT:=BYTECOUNT+1;BYTEQUEUE[BYTECOUNT]:=(255-(NIBS));END;
REPEATCOUNT:=REPEATCOUNT-NIBS;END;END;REPEATCOUNT:=0;END;{:68}{70:}
PROCEDURE DONIBBLES;LABEL 1;VAR AVALEXTRA:INTEGER;I:INTEGER;
THESAME:BOOLEAN;MOVEMENT:INTEGER;BEGIN X:=MINX;{64:}NIBBLE:=1;
BYTECOUNT:=0;{:64};{71:}GETSTARTSTOP;AVALEXTRA:=0;
WHILE NUMSTARTSTOP=0 DO BEGIN AVALEXTRA:=AVALEXTRA+1;X:=X+1;
GETSTARTSTOP;END;{WRITELN('avalextra=',AVALEXTRA:1);WRITE('initial ');
PRINTSTARTST;}{:71};{72:}{WRITELN('Start matrix');}
BEGIN WRITE(AMFFILE,(256-(NUMRUNS)));AMFBYTENO:=AMFBYTENO+1;END;
AMFHALFWORD(AVAL+2*AVALEXTRA);BEGIN WRITE(AMFFILE,BLOEXP);
AMFBYTENO:=AMFBYTENO+1;END;BEGIN WRITE(AMFFILE,(255-(VSPOTS+2)));
AMFBYTENO:=AMFBYTENO+1;END;
FOR I:=1 TO NUMSTARTSTOP DO BEGIN WRITE(AMFFILE,(255-(STARTSTOPVAL[I])))
;AMFBYTENO:=AMFBYTENO+1;END;
IF NUMSTARTSTOP<=8 THEN FOR I:=1 TO NUMSTARTSTOP DO BEGIN OLDSTARTSTOP[I
]:=STARTSTOPVAL[I];DIRECTION[I]:=0;END{:72};REPEATCOUNT:=0;
WHILE X<MAXX DO{74:}BEGIN X:=X+1;OLDNUMSTARTS:=NUMSTARTSTOP;
GETSTARTSTOP;{PRINTSTARTST;}IF NUMSTARTSTOP>8 THEN{75:}
BEGIN IF REPEATCOUNT>0 THEN DONEREPEATIN;{76:}
BEGIN BEGIN IF NIBBLE>=256 THEN DEQUEUE;NIBBLE:=NIBBLE*4+3;END;
BEGIN IF NIBBLE>=256 THEN DEQUEUE;NIBBLE:=NIBBLE*4+3;END;
BEGIN IF NIBBLE>=256 THEN DEQUEUE;NIBBLE:=NIBBLE*4+1;END;
BEGIN BYTECOUNT:=BYTECOUNT+1;BYTEQUEUE[BYTECOUNT]:=(256-(NUMRUNS));END;
FOR I:=1 TO NUMSTARTSTOP DO BEGIN BYTECOUNT:=BYTECOUNT+1;
BYTEQUEUE[BYTECOUNT]:=(255-(STARTSTOPVAL[I]));END;{WRITE('newcolsegs');
FOR I:=1 TO NUMSTARTSTOP DO WRITE(' ',STARTSTOPVAL[I]:1);WRITELN;}
END{:76};GOTO 1;END{:75};IF NUMSTARTSTOP<>OLDNUMSTARTS THEN{77:}
BEGIN IF REPEATCOUNT>0 THEN DONEREPEATIN;
IF NUMSTARTSTOP=0 THEN BEGIN REPEATCOUNT:=1;GOTO 1;END;{76:}
BEGIN BEGIN IF NIBBLE>=256 THEN DEQUEUE;NIBBLE:=NIBBLE*4+3;END;
BEGIN IF NIBBLE>=256 THEN DEQUEUE;NIBBLE:=NIBBLE*4+3;END;
BEGIN IF NIBBLE>=256 THEN DEQUEUE;NIBBLE:=NIBBLE*4+1;END;
BEGIN BYTECOUNT:=BYTECOUNT+1;BYTEQUEUE[BYTECOUNT]:=(256-(NUMRUNS));END;
FOR I:=1 TO NUMSTARTSTOP DO BEGIN BYTECOUNT:=BYTECOUNT+1;
BYTEQUEUE[BYTECOUNT]:=(255-(STARTSTOPVAL[I]));END;{WRITE('newcolsegs');
FOR I:=1 TO NUMSTARTSTOP DO WRITE(' ',STARTSTOPVAL[I]:1);WRITELN;}
END{:76};
FOR I:=1 TO NUMSTARTSTOP DO BEGIN OLDSTARTSTOP[I]:=STARTSTOPVAL[I];
DIRECTION[I]:=0;END;GOTO 1;END{:77};{78:}BEGIN THESAME:=TRUE;
FOR I:=1 TO NUMSTARTSTOP DO BEGIN DELTA[I]:=STARTSTOPVAL[I]-OLDSTARTSTOP
[I];IF DIRECTION[I]=0 THEN DELTA[I]:=-DELTA[I];
IF DELTA[I]<>0 THEN THESAME:=FALSE;END;END{:78};
IF THESAME THEN BEGIN REPEATCOUNT:=REPEATCOUNT+1;GOTO 1;END;{79:}
BEGIN IF REPEATCOUNT>0 THEN DONEREPEATIN;
FOR I:=1 TO NUMSTARTSTOP DO BEGIN MOVEMENT:=DELTA[I];
IF MOVEMENT<0 THEN BEGIN MOVEMENT:=-MOVEMENT;
IF MOVEMENT<5 THEN BEGIN BEGIN IF NIBBLE>=256 THEN DEQUEUE;
NIBBLE:=NIBBLE*4+3;END;BEGIN IF NIBBLE>=256 THEN DEQUEUE;
NIBBLE:=NIBBLE*4+3;END;BEGIN IF NIBBLE>=256 THEN DEQUEUE;
NIBBLE:=NIBBLE*4+0;END;
IF DIRECTION[I]=1 THEN DIRECTION[I]:=0 ELSE DIRECTION[I]:=1;
{WRITE(' reverse');}END;END;
IF MOVEMENT>4 THEN BEGIN BEGIN IF NIBBLE>=256 THEN DEQUEUE;
NIBBLE:=NIBBLE*4+3;END;BEGIN IF NIBBLE>=256 THEN DEQUEUE;
NIBBLE:=NIBBLE*4+2;END;BEGIN BYTECOUNT:=BYTECOUNT+1;
BYTEQUEUE[BYTECOUNT]:=(255-(STARTSTOPVAL[I]));END;DIRECTION[I]:=0;
{WRITE(' new',STARTSTOPVAL[I]:1);}
END ELSE BEGIN CASE MOVEMENT OF 0:BEGIN IF NIBBLE>=256 THEN DEQUEUE;
NIBBLE:=NIBBLE*4+0;END;1:BEGIN IF NIBBLE>=256 THEN DEQUEUE;
NIBBLE:=NIBBLE*4+1;END;2:BEGIN IF NIBBLE>=256 THEN DEQUEUE;
NIBBLE:=NIBBLE*4+2;END;3:BEGIN BEGIN IF NIBBLE>=256 THEN DEQUEUE;
NIBBLE:=NIBBLE*4+3;END;BEGIN IF NIBBLE>=256 THEN DEQUEUE;
NIBBLE:=NIBBLE*4+0;END;END;4:BEGIN BEGIN IF NIBBLE>=256 THEN DEQUEUE;
NIBBLE:=NIBBLE*4+3;END;BEGIN IF NIBBLE>=256 THEN DEQUEUE;
NIBBLE:=NIBBLE*4+1;END;END END;{WRITE(' d',MOVEMENT:1);}END;
OLDSTARTSTOP[I]:=STARTSTOPVAL[I];END;{WRITELN;}END{:79};1:END;{:74};
{73:}IF REPEATCOUNT>0 THEN DONEREPEATIN;
BEGIN IF NIBBLE>=256 THEN DEQUEUE;NIBBLE:=NIBBLE*4+3;END;
BEGIN IF NIBBLE>=256 THEN DEQUEUE;NIBBLE:=NIBBLE*4+3;END;
BEGIN IF NIBBLE>=256 THEN DEQUEUE;NIBBLE:=NIBBLE*4+1;END;
BEGIN BYTECOUNT:=BYTECOUNT+1;BYTEQUEUE[BYTECOUNT]:=(256-(1));END;
BEGIN BYTECOUNT:=BYTECOUNT+1;BYTEQUEUE[BYTECOUNT]:=(255-(VSPOTS+3));END;
BEGIN BYTECOUNT:=BYTECOUNT+1;BYTEQUEUE[BYTECOUNT]:=(255-(VSPOTS+4));END;
BEGIN IF NIBBLE>=256 THEN DEQUEUE;NIBBLE:=NIBBLE*4+3;END;
BEGIN IF NIBBLE>=256 THEN DEQUEUE;NIBBLE:=NIBBLE*4+3;END;
BEGIN IF NIBBLE>=256 THEN DEQUEUE;NIBBLE:=NIBBLE*4+3;END;
BEGIN IF NIBBLE>=256 THEN DEQUEUE;NIBBLE:=NIBBLE*4+3;END;
BEGIN IF NIBBLE>=256 THEN DEQUEUE;NIBBLE:=NIBBLE*4+0;END;
BEGIN IF NIBBLE>=256 THEN DEQUEUE;NIBBLE:=NIBBLE*4+0;END;
BEGIN IF NIBBLE>=256 THEN DEQUEUE;NIBBLE:=NIBBLE*4+0;END;
BEGIN IF NIBBLE>=256 THEN DEQUEUE;NIBBLE:=NIBBLE*4+0;END;
AMFHALFWORD(CVAL-2);{WRITELN;WRITELN('End matrix');}{:73};END;{:70}{81:}
FUNCTION AMFFIX(I:INTEGER):INTEGER;VAR R:REAL;
BEGIN R:=I*(72.27/722.909)/(MAGNIFICATIO*DESIGNSIZE/1048576);
AMFFIX:=ROUND(R*1048576);END;{:81}{82:}PROCEDURE DODESCRIPTOR;
VAR DESCRIPTOR:INTEGER;NIBBLEADDRES,NIBBLELENGTH:INTEGER;
BEGIN{WRITELN('vspots=',VSPOTS:1,' bloexp=',BLOEXP:1,' yoffset=',YOFFSET
:1,' partyoffset=',PARTYOFFSET:1,' parttop=',PARTTOP:1,' partbot=',
PARTBOT:1);}NIBBLEADDRES:=AMFBYTENO;IF(MINY>MAXY)THEN{80:}
BEGIN BEGIN WRITE(AMFFILE,128);AMFBYTENO:=AMFBYTENO+1;END;
AMFHALFWORD(AVAL);AMFHALFWORD(CVAL);{WRITELN('Empty matrix');}END{:80}
ELSE DONIBBLES;IF ODD(AMFBYTENO)THEN BEGIN WRITE(AMFFILE,0);
AMFBYTENO:=AMFBYTENO+1;END;NIBBLELENGTH:=AMFBYTENO-NIBBLEADDRES;
WHILE ODD(AMFBYTENO DIV 2)DO BEGIN WRITE(AMFFILE,0);
AMFBYTENO:=AMFBYTENO+1;END;DESCRIPTOR:=AMFBYTENO;
AMFWORD(LASTSUBGLYPH DIV 4);AMFWORD(AMFFIX(DEVICEWIDTH[CHARACTERCOD]));
AMFWORD(0);AMFWORD(0);AMFWORD(0);AMFWORD(AMFFIX(PARTYOFFSET));
AMFWORD(ROUND(10.0*1048576/(MAGNIFICATIO*DESIGNSIZE/1048576)));
AMFWORD(ROUND(10.0*1048576/(MAGNIFICATIO*DESIGNSIZE/1048576)));
AMFWORD(0);AMFWORD(0);AMFWORD(0);AMFWORD(0);AMFWORD(NIBBLEADDRES);
AMFWORD(NIBBLELENGTH);AMFWORD(0);AMFWORD(0);LASTSUBGLYPH:=DESCRIPTOR;
END;{:82}{84:}FUNCTION ENCODECHAR:INTEGER;BEGIN{WRITELN;
[36:]BEGIN Y:=MAXY;WHILE(Y>=MINY)AND(Y>=MAXY-80)DO BEGIN X:=MINX;
WHILE(X<=MAXX)AND(X<=MINX+78)DO BEGIN IF IMAGEARRAY[Y,X]=0 THEN WRITE(
' ')ELSE WRITE('*');X:=X+1;END;WRITELN(' ');Y:=Y-1;END;END[:36];}
LASTSUBGLYPH:=0;IF(MINY>MAXY)THEN{85:}BEGIN{WRITELN('Empty Character');}
AVAL:=2*DEVICEWIDTH[CHARACTERCOD];CVAL:=0;PARTYOFFSET:=0;DODESCRIPTOR;
END{:85}ELSE BEGIN{86:}AVAL:=2*MINX;
CVAL:=2*(DEVICEWIDTH[CHARACTERCOD]-MAXX-1);
{WRITELN('aval=',AVAL:1,' cval=',CVAL:1);}{:86};{87:}
IF MINY>=0 THEN BEGIN BLOEXP:=0;YOFFSET:=0;END ELSE BEGIN YOFFSET:=1;
BLOEXP:=7;WHILE-YOFFSET>MINY DO BEGIN YOFFSET:=YOFFSET*2;
BLOEXP:=BLOEXP-1;END;END;VSPOTS:=YOFFSET+MAXY+1;{:87};
IF(VSPOTS<251)AND(MINY>=-64)THEN{88:}BEGIN PARTBOT:=MINY;PARTTOP:=MAXY;
PARTYOFFSET:=0;DODESCRIPTOR;END{:88}ELSE{89:}BEGIN BLOEXP:=0;
PARTBOT:=MINY;YOFFSET:=-PARTBOT;PARTYOFFSET:=-PARTBOT;
WHILE-PARTYOFFSET<=MAXY DO BEGIN VSPOTS:=MAXY+PARTYOFFSET+1;
IF VSPOTS>251 THEN VSPOTS:=251;PARTTOP:=PARTBOT+VSPOTS-1;DODESCRIPTOR;
PARTBOT:=PARTBOT+VSPOTS;PARTYOFFSET:=PARTYOFFSET-VSPOTS;
YOFFSET:=YOFFSET-VSPOTS;END;END{:89};END;ENCODECHAR:=LASTSUBGLYPH DIV 4;
END;{:84}FUNCTION DOCHAR:BOOLEAN;LABEL 1,2,3,4,9997,9998,9999;
VAR O:EIGHTBITS;P,Q:INTEGER;BEGIN DOCHAR:=TRUE;WHILE TRUE DO{41:}
BEGIN A:=CURLOC;O:=GETBYTE;P:=FIRSTPAR(O);
IF EOF(GFFILE)THEN BEGIN WRITE(' ','Bad GF file: ',
'the file ended prematurely','!');JUMPOUT;END;{42:}IF O<=67 THEN{46:}
BEGIN IF X+P>RIGHTPIXEL THEN BEGIN IF X<=RIGHTPIXEL THEN BEGIN WRITE(A:1
,': ! ','character extends too far to the right for me');WRITELN;END;
X:=X+P;END ELSE WHILE P>0 DO BEGIN IMAGEARRAY[Y,X]:=PAINTSWITCH;X:=X+1;
P:=P-1;END;IF PAINTSWITCH=1 THEN PAINTSWITCH:=0 ELSE PAINTSWITCH:=1;
END{:46}ELSE IF(72<=O)AND(O<=239)THEN{47:}BEGIN Y:=Y-1;Z:=Z+P;X:=Z;
PAINTSWITCH:=1;END{:47}ELSE CASE O OF 69,70,71:{48:}BEGIN Y:=Y-(P+1);
X:=Z;PAINTSWITCH:=1;END{:48};{43:}240:;
247:BEGIN BEGIN WRITE(A:1,': ! ','preamble command within a page!');
WRITELN;END;GOTO 9998;END;
248,249:BEGIN BEGIN WRITE(A:1,': ! ','postamble command within a page!')
;WRITELN;END;GOTO 9998;END;
67:BEGIN BEGIN WRITE(A:1,': ! ','boc occurred before eoc');WRITELN;END;
GOTO 9998;END;68:GOTO 9999;{:43}241,242,243,244:{44:}
BEGIN BADCHAR:=FALSE;WHILE P>0 DO BEGIN Q:=GETBYTE;
IF(Q<32)OR(Q>126)THEN BADCHAR:=TRUE;P:=P-1;END;
IF BADCHAR THEN BEGIN WRITE(A:1,': ! ',
'non-ASCII character in xxx command!');WRITELN;END;END{:44};245:{45:}
{:45};OTHERS:BEGIN WRITE(A:1,': ! ','undefined command ',O:1,'!');
WRITELN;END END{:42};END{:41};9998:WRITELN('!');DOCHAR:=FALSE;GOTO 9997;
9999:{49:}{WRITELN;
WRITELN('before: minx=',MINX:1,' maxx=',MAXX:1,' miny=',MINY:1,' maxy=',
MAXY:1);}Y:=MINY;WHILE Y<=MAXY DO BEGIN X:=MINX;
WHILE X<=MAXX DO BEGIN IF IMAGEARRAY[Y,X]=1 THEN GOTO 1;X:=X+1;END;
Y:=Y+1;MINY:=Y;END;1:IF(MINY>MAXY)THEN BEGIN MINX:=MAXX+1;GOTO 4;END;
Y:=MAXY;WHILE Y>MINY DO BEGIN X:=MINX;
WHILE X<=MAXX DO BEGIN IF IMAGEARRAY[Y,X]=1 THEN GOTO 2;X:=X+1;END;
Y:=Y-1;MAXY:=Y;END;2:X:=MINX;WHILE X<MAXX DO BEGIN Y:=MINY;
WHILE Y<=MAXY DO BEGIN IF IMAGEARRAY[Y,X]=1 THEN GOTO 3;Y:=Y+1;END;
X:=X+1;MINX:=X;END;3:X:=MAXX;WHILE X>MINX DO BEGIN Y:=MINY;
WHILE Y<=MAXY DO BEGIN IF IMAGEARRAY[Y,X]=1 THEN GOTO 4;Y:=Y+1;END;
X:=X-1;MAXX:=X;END;4:COLS:=MAXX-MINX+1;ROWS:=MAXY-MINY+1;
{WRITELN('after : minx=',MINX:1,' maxx=',MAXX:1,' miny=',MINY:1,' maxy='
,MAXY:1);WRITELN('cols=',COLS:1,' rows=',ROWS:1);}{:49};{61:}
IF SUBGLYPHPTR[CHARACTERCOD]<>0 THEN BEGIN WRITE(A:1,': ! ',
'Duplicate character');WRITELN;END;
SUBGLYPHPTR[CHARACTERCOD]:=ENCODECHAR;{:61};9997:END;{:40}{51:}
PROCEDURE READPOSTAMBL;VAR K:INTEGER;P,Q,M,C:INTEGER;
BEGIN POSTLOC:=CURLOC-1;
WRITELN('Postamble starts at byte ',POSTLOC:1,'.');P:=SIGNEDQUAD;
DESIGNSIZE:=SIGNEDQUAD;CHECKSUM:=SIGNEDQUAD;
WRITE('design size = ',DESIGNSIZE:1,' (');
PRINTSCALED(DESIGNSIZE DIV 16);WRITELN(')');
WRITELN('check sum = ',CHECKSUM:1);HPPP:=SIGNEDQUAD;VPPP:=SIGNEDQUAD;
WRITE('hppp = ',HPPP:1,' (');PRINTSCALED(HPPP);WRITELN(')');
WRITE('vppp = ',VPPP:1,' (');PRINTSCALED(VPPP);WRITELN(')');
MAGNIFICATIO:=HPPP/(65536.0*722.909/72.27);
AMFMAG:=ROUND(1000*MAGNIFICATIO);WRITELN('mag = ',AMFMAG:1);
MINX:=SIGNEDQUAD;MAXX:=SIGNEDQUAD;MINY:=SIGNEDQUAD;MAXY:=SIGNEDQUAD;
WRITELN('min x = ',MINX:1,', max x = ',MAXX:1);
WRITELN('min y = ',MINY:1,', max y = ',MAXY:1);{54:}REPEAT K:=GETBYTE;
IF K=246 THEN BEGIN C:=FIRSTPAR(K);
IF C>MAXCHARNO THEN BEGIN WRITE(' ','Character number too large');
JUMPOUT;END;DEVICEWIDTH[C]:=SIGNEDQUAD;TFMWIDTH[C]:=SIGNEDQUAD;
P:=SIGNEDQUAD;K:=240;END;UNTIL K<>240;{:54};{53:}
IF K<>249 THEN BEGIN WRITE(A:1,': ! ','should be postpost!');WRITELN;
END;Q:=SIGNEDQUAD;
IF Q<>POSTLOC THEN BEGIN WRITE(A:1,': ! ','postamble pointer should be '
,POSTLOC:1,' not ',Q:1);WRITELN;END;M:=GETBYTE;
IF M<>129 THEN BEGIN WRITE(A:1,': ! ','identification byte should be ',
129:1);WRITELN;END;K:=CURLOC;M:=223;
WHILE(M=223)AND NOT EOF(GFFILE)DO M:=GETBYTE;
IF NOT EOF(GFFILE)THEN BEGIN WRITE(' ','Bad GF file: ',
'signature in byte ',CURLOC-1:1,' should be 223','!');JUMPOUT;
END ELSE IF CURLOC<K+4 THEN BEGIN WRITE(A:1,': ! ',
'not enough signature bytes at end of file');WRITELN;END;{:53};END;{:51}
{55:}PROCEDURE FINDPOSTAMBL;VAR Q,K:INTEGER;BEGIN POSTLOC:=GFLENGTH-4;
REPEAT IF POSTLOC=0 THEN BEGIN WRITE(' ','Bad GF file: ','all 223s','!')
;JUMPOUT;END;MOVETOBYTE(POSTLOC);K:=GETBYTE;POSTLOC:=POSTLOC-1;
UNTIL K<>223;
IF K<>129 THEN BEGIN WRITE(' ','Bad GF file: ','ID byte is ',K:1,'!');
JUMPOUT;END;MOVETOBYTE(POSTLOC-3);Q:=SIGNEDQUAD;
IF(Q<0)OR(Q>POSTLOC-3)THEN BEGIN WRITE(' ','Bad GF file: ',
'post pointer ',Q:1,' at byte ',POSTLOC-3:1,'!');JUMPOUT;END;
MOVETOBYTE(Q);K:=GETBYTE;
IF K<>248 THEN BEGIN WRITE(' ','Bad GF file: ','byte ',Q:1,
' is not post','!');JUMPOUT;END;END;{:55}{90:}BEGIN INITIALIZE;
OPENGFFILE;FINDPOSTAMBL;READPOSTAMBL;OPENGFFILE;{92:}O:=GETBYTE;
IF O<>247 THEN BEGIN WRITE(' ','Bad GF file: ',
'First byte isn''t start of preamble!','!');JUMPOUT;END;O:=GETBYTE;
IF O<>129 THEN BEGIN WRITE(A:1,': ! ','identification byte should be ',
129:1,' not ',O:1,'!');WRITELN;END;O:=GETBYTE;WRITE('''');
WHILE O>0 DO BEGIN O:=O-1;WRITE(XCHR[GETBYTE]);END;WRITELN('''');{:92};
OPENAMFFILE;{59:}AMFBYTENO:=0;AMFWORD(175);
{WRITELN('Start of AMF info');}{:59}{93:}REPEAT{94:}REPEAT A:=CURLOC;
O:=GETBYTE;P:=FIRSTPAR(O);
IF EOF(GFFILE)THEN BEGIN WRITE(' ','Bad GF file: ',
'the file ended prematurely','!');JUMPOUT;END;IF O=245 THEN BEGIN{45:}
{:45};O:=240;END ELSE IF(O>=241)AND(O<=244)THEN BEGIN{44:}
BEGIN BADCHAR:=FALSE;WHILE P>0 DO BEGIN Q:=GETBYTE;
IF(Q<32)OR(Q>126)THEN BADCHAR:=TRUE;P:=P-1;END;
IF BADCHAR THEN BEGIN WRITE(A:1,': ! ',
'non-ASCII character in xxx command!');WRITELN;END;END{:44};O:=240;END;
UNTIL O<>240;{:94};
IF O<>248 THEN BEGIN IF O<>67 THEN BEGIN WRITE(' ','Bad GF file: ',
'byte ',CURLOC-1:1,' is not boc (',O:1,')','!');JUMPOUT;END;{95:}
A:=CURLOC;CHARACTERCOD:=SIGNEDQUAD;WRITE('[',CHARACTERCOD:1);
IF CHARACTERCOD>MAXCHARNO THEN BEGIN WRITE(' ',
'Character number too large');JUMPOUT;END;
IF CHARACTERCOD>EC THEN EC:=CHARACTERCOD;
IF CHARACTERCOD<BC THEN BC:=CHARACTERCOD;P:=SIGNEDQUAD;MINX:=SIGNEDQUAD;
MAXX:=SIGNEDQUAD;MINY:=SIGNEDQUAD;MAXY:=SIGNEDQUAD;
IF MINX<LEFTPIXEL THEN BEGIN WRITE(' ','Pixels beyond left limit');
JUMPOUT;END;
IF MAXX>RIGHTPIXEL THEN BEGIN WRITE(' ','Pixels beyond right limit');
JUMPOUT;END;
IF MINY<BOTPIXEL THEN BEGIN WRITE(' ','Pixels beyond bottom limit');
JUMPOUT;END;
IF MAXY>TOPPIXEL THEN BEGIN WRITE(' ','Pixels beyond top limit');
JUMPOUT;END;Z:=SIGNEDQUAD;
IF(Z>MAXX)OR(Z<MINX)THEN BEGIN WRITE(A:1,': ! ',
'Parameter z is out of range');WRITELN;END;{35:}BEGIN Y:=MINY;
WHILE Y<=MAXY DO BEGIN X:=MINX;
WHILE X<=MAXX DO BEGIN IMAGEARRAY[Y,X]:=0;X:=X+1;END;Y:=Y+1;END;END{:35}
;Y:=MAXY;X:=Z;PAINTSWITCH:=1;{:95};
IF NOT DOCHAR THEN BEGIN WRITE(' ','Bad GF file: ',
'char ended unexpectedly','!');JUMPOUT;END;WRITE(']');
TOTALCHARS:=TOTALCHARS+1;IF(TOTALCHARS MOD 10)=0 THEN WRITELN;
END UNTIL O=248;{:93};WRITELN;{60:}AMFWORD(0);
IF(AMFBYTENO MOD 4)<>0 THEN BEGIN WRITE(' ',
'This can''t happen: alignment');JUMPOUT;END;AMFDIRPTR:=AMFBYTENO DIV 4;
FOR CHARACTERCOD:=BC TO EC DO AMFWORD(SUBGLYPHPTR[CHARACTERCOD]);
FOR CHARACTERCOD:=BC TO EC DO AMFWORD(TFMWIDTH[CHARACTERCOD]);
AMFWORD(BC);AMFWORD(EC);AMFWORD(CHECKSUM);AMFWORD(AMFMAG);
AMFWORD(DESIGNSIZE);AMFWORD(AMFDIRPTR);AMFWORD(175);
{WRITELN('End of AMF info');}{:60}
WRITE('Font had ',TOTALCHARS:1,' character');
IF TOTALCHARS<>1 THEN WRITE('s');WRITE(' altogether');9999:END.{:90}